One of the beauties of a Forth-based system is that it is easy to implement
multitasking. This allows us to do interesting things like continue processing
while a window is being dragged etc. Most Mac applications can't manage this.
It makes our applications look unbelievably sophisticated, and yet this code is
only about 2500 bytes. This is possible because the Forth approach to
multitasking, as usual, simplifies things considerably compared with other
systems.
The main simplifying factor is that the scheme is cooperative. Tasks cannot be
interrupted at any arbitrary point, but must execute PAUSE to allow other tasks
to have a turn. This allows the overhead for switching tasks to be just about
20 machine instructions.
This code is based on that in the Laxen/Perry F83, including the extra features
added by yours truly in the PDP-11 implementation, notably the mechanism to
keep track of the status of a task. We make some necessary Mac and Mops
adaptations here - in particular, a task becomes a Mops object, and we set the
various user hook locations (e.g. DragHook) to point to a routine to run the
task round-robin. Another addition is that each task has a queue of tasks
waiting on it. This avoids a waiting task having to waste time testing the
other task each time round. A waiting task can now be put to sleep, and the
time penalty for each waiting task is reduced to one machine JMP instruction
each time round the task loop. If it was worth it, we could even remove the
task from the loop altogether, but it probably isn't worth it.
Another necessary Mac adjustment is that we must distinguish between a
foreground task and various background tasks. Any time WaitNextEvent is
called, all kinds of things can happen which can use several K of stack space.
Therefore we assume in allocating this space that WNE will only be called from
the foreground task, and we don't need to allocate as much stack space for
background tasks. Also, the hook procedures must be able to ensure that WNE
will not be called during their execution (very illegal). If we call WNE only
from the foreground task, there's no problem. The hook procedures then always
execute as part of the foreground task (they're called by the system at WNE
time), and even if they give background tasks some time before they return,
these background tasks won't be calling WNE.
Another thing to watch is that a background task shouldn't do any drawing to
the screen Not only doesn't it know which GrafPort is switched in, I have also
found QuickDraw doing some strange things in the "unused" area of the stack
between BufPtr and the current A7 stack pointer!! We therefore now put the
foreground stack LOWEST in memory - this necessitates moving the stack when a
background task is allocated, but at least it avoids any problems with
QuickDraw, since, assuming QuickDraw calls only result from foreground tasks,
the stack pointer at system call time will really represent the lowest address
we need for any of our stacks.↵
Our general philosophy, then, is that the foreground task will look after the
user interface, do all drawing to the screen, and manage the event loop. It
will delegate any lengthy computation to background tasks, which therefore just
function as computing engines for the foreground.
Things would have been a lot easier if we could have allocated a heap block for
each background task's stack. But then we would get caught by the VBL "stack
sniffer" routine, which would find SP pointing below ApplLimit, think that the
stack had encroached into the heap zone, and politely bow out with system error
28 (stack collides with heap).
¥ ================================
¥ Here we define values for the space to be allocated for the Mops stacks for new tasks. These values may be changed as required. It's better to err on the big side. Remember that any Toolbox calls can use a lot of data stack space.
2000 value R_SPACE
3000 value S_SPACE
16000 value FGD_S_SPACE
0 value REAL_RP0
0 value NEW_SP
¥ Possible task statuses:
type{ AWAKE ASLEEP WAITING STOPPED TERMINATED AVAILABLE CRASHED }
¥ Constants for the 68000 opcodes we need:
$ 4EF9 constant QJMP ¥ JMP (absolute long)
$ 6104 constant QBSR ¥ BSR +4
objPtr THIS_TASK ¥ Points to the currently running task.
objPtr TSK1 ¥ Used for tracking task queues.
objPtr TSK2 ¥ Will be set to class Task.
0 value STP ¥ Stack allocation pointer.
¥ ====================
:code SUSPEND
movem.l d2-d7/a2/a5/a7,-(a6) ; Save all relevant regs
movem.l dic[ExtraLocals],d0-d7/a0/a1 ; Save ExtraLocals area
movem.l d0-d7/a0/a1,-(a6)
movem.l 40(dic[ExtraLocals]),d0-d7/a0/a1
movem.l d0-d7/a0/a1,-(a6)
move dic[this_task],a1
move a6,12(a1) ; Save data stk ptr in task object
move 2(a1),a0
jmp (a0) ; JMP to LINK to restart next task.
;code
:code RESTART
move (a7)+,a1
subq #2,a1 ; A1 -> task object addr
move 18(a1),dic[SP0] ; Set SP0
move 22(a1),dic[RP0] ; Set RP0
move 12(a1),a6 ; Set SP
lea rel[this_task],a0 ; We may be based on A5, not set up yet
move.l a1,(a0)
movem.l (a6)+,d0-d7/a0/a1 ; Restore ExtraLocals area
movem.l d0-d7/a0/a1,40(dic[ExtraLocals]
movem.l (a6)+,d0-d7/a0/a1
movem.l d0-d7/a0/a1,dic[ExtraLocals]
movem.l (a6)+,d2-d7/a2/a5/a7 ; Restore saved regs
rts
;code
: NoRoom 159 die ;
:code MOVE_TASKS ¥ ( dist -- )
loc
pop.l d1 ; D1 = distance to move
move.l a6,d0
sub.l d1,d0 ; D0 = tentative destination
cmp.l glob[ApplLimit],d0
blo.s dic[noRoom]
sub.l d1,dic[SP0]
sub.l d1,dic[RP0]
move.l d0,a1 ; A1 -> destination
move.l dic[real_RP0],d0
sub.l a6,d0 ; D0 = #bytes to move
move.l a7,a0
sub.l d1,a0
move.l a0,dic[new_SP]
move.l a6,a0 ; A0 -> source
move.l a1,a7 ; Set A7 low in case of an interrupt during
move.l a1,a6 ; the loop
addq.l #8,d0
loop move.l (a0)+,(a1)+
subq.l #4,d0
lptest bgt.s loop
move.l dic[new_SP],a7
;code
forward CRASH
forward NOWHERE
:class TASK super{ object }
record
{ int ENTRY
var LINK
int JMP_CODE
var ^RESTART
var ^SP
int STATUS
var tSP0
var tRP0
var QUEUE
var QLINK
int QSTATUS
}
' this_task set_to_class task
' tsk1 set_to_class task
' tsk2 set_to_class task
:m (SLEEP): QJMP put: entry ;m
:m SLEEP: asleep put: status (sleep): self ;m
:m WAKE: QBSR put: entry awake put: status ;m
:m NEXT: get: link ;m
:m SETNEXT: put: link ;m
:m NEXTQ: get: Qlink ;m
:m SETNEXTQ: put: Qlink ;m
:m ?RESUME: ¥ ( status# -- b )
get: Qstatus >= dup
IF wake: self THEN ;m
:m RELEASEQ:
nilP -> tsk1 get: queue -> tsk2
BEGIN
tsk2 nilP = ?EXIT
get: status ?resume: tsk2
IF ( resumed - remove from queue )
nextQ: tsk2
tsk1 nilP =
IF put: queue ELSE setnextQ: tsk1 THEN
THEN
tsk2 -> tsk1 nextQ: tsk2 -> tsk2
AGAIN ;m
:m (WAIT): ¥ ( status# -- ) Used by Wait: - see below.
put: Qstatus waiting put: status releaseQ: self
(sleep): self ;m
:m WAIT: ¥ ( status# -- ).
¥ If the given status# is greater than the status of SELF, the currently
¥ running task is queued and put to sleep. It will be woken when the
¥ status of SELF goes to the given status# or higher. If the given status#
¥ is less than or equal to the status of SELF, we don't queue this_task,
¥ since the condition it wishes to wait for has already occurred. However
¥ we make it do a "phantom" wait so that its own queue will be released.
¥ Logically it has waited, so any tasks waiting for it to wait, must be
¥ released.
dup (wait): this_task
get: status <=
IF wake: this_task
ELSE
get: queue setnextQ: this_task
this_task put: queue
next_task
THEN ;m
:m STATUS: get: status ;m
:m SETSTATUS: put: status releaseQ: self ;m
:m ASSIGN: { PC ¥ sptr -- }
get: status available <> abort" Task not available"
¥ Now we set up a "saved reg" image so that it looks like
¥ we've been suspended with PC as the return address.
